home *** CD-ROM | disk | FTP | other *** search
Text File | 1998-08-17 | 36.6 KB | 1,404 lines | [TEXT/MPS ] |
- ;
- ; File: fp.a
- ;
- ; Contains: FPCE Floating-Point Definitions and Declarations.
- ;
- ; Version: Technology: MathLib v2
- ; Release: Universal Interfaces 3.2
- ;
- ; Copyright: © 1987-1998 by Apple Computer, Inc., all rights reserved.
- ;
- ; Bugs?: For bug reports, consult the following page on
- ; the World Wide Web:
- ;
- ; http://developer.apple.com/bugreporter/
- ;
- ;
- IF &TYPE('__FP__') = 'UNDEFINED' THEN
- __FP__ SET 1
-
- IF &TYPE('__CONDITIONALMACROS__') = 'UNDEFINED' THEN
- include 'ConditionalMacros.a'
- ENDIF
- IF &TYPE('__MACTYPES__') = 'UNDEFINED' THEN
- include 'MacTypes.a'
- ENDIF
-
- ; ********************************************************************************
- ;* *
- ;* A collection of numerical functions designed to facilitate a wide *
- ;* range of numerical programming as required by C9X. *
- ;* *
- ;* The <fp.h> declares many functions in support of numerical programming. *
- ;* It provides a superset of <math.h> and <SANE.h> functions. Some *
- ;* functionality previously found in <SANE.h> and not in the FPCE <fp.h> *
- ;* can be found in this <fp.h> under the heading "__NOEXTENSIONS__". *
- ;* *
- ;* All of these functions are IEEE 754 aware and treat exceptions, NaNs, *
- ;* positive and negative zero and infinity consistent with the floating- *
- ;* point standard. *
- ;* *
- ;*******************************************************************************
-
-
- ; ********************************************************************************
- ;* *
- ;* Efficient types *
- ;* *
- ;* float_t Most efficient type at least as wide as float *
- ;* double_t Most efficient type at least as wide as double *
- ;* *
- ;* CPU float_t(bits) double_t(bits) *
- ;* -------- ----------------- ----------------- *
- ;* PowerPC float(32) double(64) *
- ;* 68K long double(80/96) long double(80/96) *
- ;* x86 long double(80) long double(80) *
- ;* *
- ;*******************************************************************************
-
- IF TARGET_CPU_PPC THEN
- ; typedef float float_t
-
- ; typedef double double_t
-
- ELSEIF TARGET_CPU_68K THEN
- ; typedef long double float_t
-
- ; typedef long double double_t
-
- ELSEIF TARGET_CPU_X86 THEN
- IF NeXT THEN
- ; typedef double float_t
-
- ; typedef double double_t
-
- ELSE
- ; typedef long double float_t
-
- ; typedef long double double_t
-
- ENDIF ; NeXT
- ELSEIF TARGET_CPU_MIPS THEN
- ; typedef double float_t
-
- ; typedef double double_t
-
- ELSEIF TARGET_CPU_ALPHA THEN
- ; typedef double float_t
-
- ; typedef double double_t
-
- ELSEIF TARGET_CPU_SPARC THEN
- ; typedef double float_t
-
- ; typedef double double_t
-
- ELSE
- ENDIF ;
-
- ; ********************************************************************************
- ;* *
- ;* Define some constants. *
- ;* *
- ;* HUGE_VAL IEEE 754 value of infinity. *
- ;* INFINITY IEEE 754 value of infinity. *
- ;* NAN A generic NaN (Not A Number). *
- ;* DECIMAL_DIG Satisfies the constraint that the conversion from *
- ;* double to decimal and back is the identity function. *
- ;* *
- ;*******************************************************************************
-
- IF TARGET_OS_MAC THEN
- ; ********************************************************************************
- ;* *
- ;* Trigonometric functions *
- ;* *
- ;* acos result is in [0,pi]. *
- ;* asin result is in [-pi/2,pi/2]. *
- ;* atan result is in [-pi/2,pi/2]. *
- ;* atan2 Computes the arc tangent of y/x in [-pi,pi] using the sign of *
- ;* both arguments to determine the quadrant of the computed value. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t cos(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION cos
- ENDIF
-
- ;
- ; extern double_t sin(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sin
- ENDIF
-
- ;
- ; extern double_t tan(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION tan
- ENDIF
-
- ;
- ; extern double_t acos(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION acos
- ENDIF
-
- ;
- ; extern double_t asin(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION asin
- ENDIF
-
- ;
- ; extern double_t atan(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atan
- ENDIF
-
- ;
- ; extern double_t atan2(double_t y, double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atan2
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Hyperbolic functions *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t cosh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION cosh
- ENDIF
-
- ;
- ; extern double_t sinh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sinh
- ENDIF
-
- ;
- ; extern double_t tanh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION tanh
- ENDIF
-
- ;
- ; extern double_t acosh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION acosh
- ENDIF
-
- ;
- ; extern double_t asinh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION asinh
- ENDIF
-
- ;
- ; extern double_t atanh(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atanh
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Exponential functions *
- ;* *
- ;* expm1 expm1(x) = exp(x) - 1. But, for small enough arguments, *
- ;* expm1(x) is expected to be more accurate than exp(x) - 1. *
- ;* frexp Breaks a floating-point number into a normalized fraction *
- ;* and an integral power of 2. It stores the integer in the *
- ;* object pointed by *exponent. *
- ;* ldexp Multiplies a floating-point number by an integer power of 2. *
- ;* log1p log1p = log(1 + x). But, for small enough arguments, *
- ;* log1p is expected to be more accurate than log(1 + x). *
- ;* logb Extracts the exponent of its argument, as a signed integral *
- ;* value. A subnormal argument is treated as though it were first *
- ;* normalized. Thus: *
- ;* 1 <= x * 2^(-logb(x)) < 2 *
- ;* modf Returns fractional part of x as function result and returns *
- ;* integral part of x via iptr. Note C9X uses double not double_t. *
- ;* scalb Computes x * 2^n efficently. This is not normally done by *
- ;* computing 2^n explicitly. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t exp(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION exp
- ENDIF
-
- ;
- ; extern double_t expm1(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION expm1
- ENDIF
-
- ;
- ; extern double_t exp2(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION exp2
- ENDIF
-
- ;
- ; extern double_t frexp(double_t x, int *exponent)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION frexp
- ENDIF
-
- ;
- ; extern double_t ldexp(double_t x, int n)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ldexp
- ENDIF
-
- ;
- ; extern double_t log(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log
- ENDIF
-
- ;
- ; extern double_t log2(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log2
- ENDIF
-
- ;
- ; extern double_t log1p(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log1p
- ENDIF
-
- ;
- ; extern double_t log10(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log10
- ENDIF
-
- ;
- ; extern double_t logb(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION logb
- ENDIF
-
- ;
- ; extern double_t modf(double_t x, double_t *iptr)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION modf
- ENDIF
-
- ;
- ; extern float modff(float x, float *iptrf)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION modff
- ENDIF
-
- ;
- ; extern double_t scalb(double_t x, long n)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION scalb
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Power and absolute value functions *
- ;* *
- ;* hypot Computes the square root of the sum of the squares of its *
- ;* arguments, without undue overflow or underflow. *
- ;* pow Returns x raised to the power of y. Result is more accurate *
- ;* than using exp(log(x)*y). *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t fabs(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fabs
- ENDIF
-
- ;
- ; extern double_t hypot(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION hypot
- ENDIF
-
- ;
- ; extern double_t pow(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION pow
- ENDIF
-
- ;
- ; extern double_t sqrt(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sqrt
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Gamma and Error functions *
- ;* *
- ;* erf The error function. *
- ;* erfc Complementary error function. *
- ;* gamma The gamma function. *
- ;* lgamma Computes the base-e logarithm of the absolute value of *
- ;* gamma of its argument x, for x > 0. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t erf(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION erf
- ENDIF
-
- ;
- ; extern double_t erfc(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION erfc
- ENDIF
-
- ;
- ; extern double_t gamma(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION gamma
- ENDIF
-
- ;
- ; extern double_t lgamma(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION lgamma
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Nearest integer functions *
- ;* *
- ;* rint Rounds its argument to an integral value in floating point *
- ;* format, honoring the current rounding direction. *
- ;* *
- ;* nearbyint Differs from rint only in that it does not raise the inexact *
- ;* exception. It is the nearbyint function recommended by the *
- ;* IEEE floating-point standard 854. *
- ;* *
- ;* rinttol Rounds its argument to the nearest long int using the current *
- ;* rounding direction. NOTE: if the rounded value is outside *
- ;* the range of long int, then the result is undefined. *
- ;* *
- ;* round Rounds the argument to the nearest integral value in floating *
- ;* point format similar to the Fortran "anint" function. That is: *
- ;* add half to the magnitude and chop. *
- ;* *
- ;* roundtol Similar to the Fortran function nint or to the Pascal round. *
- ;* NOTE: if the rounded value is outside the range of long int, *
- ;* then the result is undefined. *
- ;* *
- ;* trunc Computes the integral value, in floating format, nearest to *
- ;* but no larger in magnitude than its argument. NOTE: on 68K *
- ;* compilers when using -elems881, trunc must return an int *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t ceil(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ceil
- ENDIF
-
- ;
- ; extern double_t floor(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION floor
- ENDIF
-
- ;
- ; extern double_t rint(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION rint
- ENDIF
-
- ;
- ; extern double_t nearbyint(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nearbyint
- ENDIF
-
- ;
- ; extern long rinttol(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION rinttol
- ENDIF
-
- ;
- ; extern double_t round(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION round
- ENDIF
-
- ;
- ; extern long roundtol(double_t round)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION roundtol
- ENDIF
-
- IF TARGET_CPU_68K THEN
- ;
- ; extern int trunc(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION trunc
- ENDIF
-
- ELSE
- ;
- ; extern double_t trunc(double_t x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION trunc
- ENDIF
-
- ENDIF ; TARGET_CPU_68K
-
- ; ********************************************************************************
- ;* *
- ;* Remainder functions *
- ;* *
- ;* remainder IEEE 754 floating point standard for remainder. *
- ;* remquo SANE remainder. It stores into 'quotient' the 7 low-order *
- ;* bits of the integer quotient x/y, such that: *
- ;* -127 <= quotient <= 127. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t fmod(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fmod
- ENDIF
-
- ;
- ; extern double_t remainder(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION remainder
- ENDIF
-
- ;
- ; extern double_t remquo(double_t x, double_t y, int *quo)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION remquo
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Auxiliary functions *
- ;* *
- ;* copysign Produces a value with the magnitude of its first argument *
- ;* and sign of its second argument. NOTE: the order of the *
- ;* arguments matches the recommendation of the IEEE 754 *
- ;* floating point standard, which is opposite from the SANE *
- ;* copysign function. *
- ;* *
- ;* nan The call 'nan("n-char-sequence")' returns a quiet NaN *
- ;* with content indicated through tagp in the selected *
- ;* data type format. *
- ;* *
- ;* nextafter Computes the next representable value after 'x' in the *
- ;* direction of 'y'. if x == y, then y is returned. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t copysign(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION copysign
- ENDIF
-
- ;
- ; extern double nan(const char *tagp)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nan
- ENDIF
-
- ;
- ; extern float nanf(const char *tagp)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nanf
- ENDIF
-
- ;
- ; extern double nextafterd(double x, double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nextafterd
- ENDIF
-
- ;
- ; extern float nextafterf(float x, float y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nextafterf
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Inquiry macros *
- ;* *
- ;* fpclassify Returns one of the FP_≈ values. *
- ;* isnormal Non-zero if and only if the argument x is normalized. *
- ;* isfinite Non-zero if and only if the argument x is finite. *
- ;* isnan Non-zero if and only if the argument x is a NaN. *
- ;* signbit Non-zero if and only if the sign of the argument x is *
- ;* negative. This includes, NaNs, infinities and zeros. *
- ;* *
- ;*******************************************************************************
-
-
- FP_SNAN EQU 0 ; signaling NaN
- FP_QNAN EQU 1 ; quiet NaN
- FP_INFINITE EQU 2 ; + or - infinity
- FP_ZERO EQU 3 ; + or - zero
- FP_NORMAL EQU 4 ; all normal numbers
- FP_SUBNORMAL EQU 5 ; denormal numbers
-
-
- ;
- ; extern long __fpclassifyd(double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __fpclassifyd
- ENDIF
-
- ;
- ; extern long __fpclassifyf(float x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __fpclassifyf
- ENDIF
-
- ;
- ; extern long __isnormald(double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isnormald
- ENDIF
-
- ;
- ; extern long __isnormalf(float x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isnormalf
- ENDIF
-
- ;
- ; extern long __isfinited(double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isfinited
- ENDIF
-
- ;
- ; extern long __isfinitef(float x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isfinitef
- ENDIF
-
- ;
- ; extern long __isnand(double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isnand
- ENDIF
-
- ;
- ; extern long __isnanf(float x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __isnanf
- ENDIF
-
- ;
- ; extern long __signbitd(double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __signbitd
- ENDIF
-
- ;
- ; extern long __signbitf(float x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __signbitf
- ENDIF
-
- ;
- ; extern double_t __inf(void )
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION __inf
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Max, Min and Positive Difference *
- ;* *
- ;* fdim Determines the 'positive difference' between its arguments: *
- ;* { x - y, if x > y }, { +0, if x <= y }. If one argument is *
- ;* NaN, then fdim returns that NaN. if both arguments are NaNs, *
- ;* then fdim returns the first argument. *
- ;* *
- ;* fmax Returns the maximum of the two arguments. Corresponds to the *
- ;* max function in FORTRAN. NaN arguments are treated as missing *
- ;* data. If one argument is NaN and the other is a number, then *
- ;* the number is returned. If both are NaNs then the first *
- ;* argument is returned. *
- ;* *
- ;* fmin Returns the minimum of the two arguments. Corresponds to the *
- ;* min function in FORTRAN. NaN arguments are treated as missing *
- ;* data. If one argument is NaN and the other is a number, then *
- ;* the number is returned. If both are NaNs then the first *
- ;* argument is returned. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t fdim(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fdim
- ENDIF
-
- ;
- ; extern double_t fmax(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fmax
- ENDIF
-
- ;
- ; extern double_t fmin(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fmin
- ENDIF
-
-
-
- ; *******************************************************************************
- ;* Constants *
- ;******************************************************************************
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Non NCEG extensions *
- ;* *
- ;*******************************************************************************
-
- IF &TYPE('__NOEXTENSIONS__') = 'UNDEFINED' THEN
- ; ********************************************************************************
- ;* *
- ;* Financial functions *
- ;* *
- ;* compound Computes the compound interest factor "(1 + rate)^periods" *
- ;* more accurately than the straightforward computation with *
- ;* the Power function. This is SANE's compound function. *
- ;* *
- ;* annuity Computes the present value factor for an annuity *
- ;* "(1 - (1 + rate)^(-periods)) /rate" more accurately than *
- ;* the straightforward computation with the Power function. *
- ;* This is SANE's annuity function. *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t compound(double_t rate, double_t periods)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION compound
- ENDIF
-
- ;
- ; extern double_t annuity(double_t rate, double_t periods)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION annuity
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Random function *
- ;* *
- ;* randomx A pseudorandom number generator. It uses the iteration: *
- ;* (7^5*x)mod(2^31-1) *
- ;* *
- ;*******************************************************************************
-
- ;
- ; extern double_t randomx(double_t *x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION randomx
- ENDIF
-
-
-
- ; *******************************************************************************
- ;* Relational operator *
- ;******************************************************************************
-
- ; relational operator
- ; typedef short relop
-
-
- GREATERTHAN EQU 0
- LESSTHAN EQU 1
- EQUALTO EQU 2
- UNORDERED EQU 3
- ;
- ; extern relop relation(double_t x, double_t y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION relation
- ENDIF
-
-
-
- ; ********************************************************************************
- ;* *
- ;* Binary to decimal conversions *
- ;* *
- ;* SIGDIGLEN Significant decimal digits. *
- ;* *
- ;* decimal A record which provides an intermediate unpacked form for *
- ;* programmers who wish to do their own parsing of numeric input *
- ;* or formatting of numeric output. *
- ;* *
- ;* decform Controls each conversion to a decimal string. The style field *
- ;* is either FLOATDECIMAL or FIXEDDECIMAL. If FLOATDECIMAL, the *
- ;* value of the field digits is the number of significant digits. *
- ;* If FIXEDDECIMAL value of the field digits is the number of *
- ;* digits to the right of the decimal point. *
- ;* *
- ;* num2dec Converts a double_t to a decimal record using a decform. *
- ;* dec2num Converts a decimal record d to a double_t value. *
- ;* dec2str Converts a decform and decimal to a string using a decform. *
- ;* str2dec Converts a string to a decimal struct. *
- ;* dec2d Similar to dec2num except a double is returned (68k only). *
- ;* dec2f Similar to dec2num except a float is returned. *
- ;* dec2s Similar to dec2num except a short is returned. *
- ;* dec2l Similar to dec2num except a long is returned. *
- ;* *
- ;*******************************************************************************
-
- IF TARGET_CPU_PPC THEN
-
- SIGDIGLEN EQU 36
- ELSE
-
- SIGDIGLEN EQU 20
- ENDIF ; TARGET_CPU_PPC
-
- DECSTROUTLEN EQU 80 ; max length for dec2str output
-
- decimal RECORD 0
- sgn ds.b 1 ; offset: $0 (0) ; sign 0 for +, 1 for -
- unused ds.b 1 ; offset: $1 (1)
- exp ds.w 1 ; offset: $2 (2) ; decimal exponent
- sig ds.b SIGDIGLEN+2 ; offset: $4 (4) ; significant digits (pascal string)
- sizeof EQU * ; size: $1A (26) or $2A (42)
- ENDR
-
- decform RECORD 0
- style ds.b 1 ; offset: $0 (0) ; FLOATDECIMAL or FIXEDDECIMAL
- unused ds.b 1 ; offset: $1 (1)
- digits ds.w 1 ; offset: $2 (2)
- sizeof EQU * ; size: $4 (4)
- ENDR
- ;
- ; extern void num2dec(const decform *f, double_t x, decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION num2dec
- ENDIF
-
- ;
- ; extern double_t dec2num(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2num
- ENDIF
-
- ;
- ; extern void dec2str(const decform *f, const decimal *d, char *s)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2str
- ENDIF
-
- ;
- ; extern void str2dec(const char *s, short *ix, decimal *d, short *vp)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION str2dec
- ENDIF
-
- IF TARGET_CPU_68K THEN
- ;
- ; extern double dec2d(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2d
- ENDIF
-
- ENDIF ; TARGET_CPU_68K
- ;
- ; extern float dec2f(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2f
- ENDIF
-
- ;
- ; extern short dec2s(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2s
- ENDIF
-
- ;
- ; extern long dec2l(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2l
- ENDIF
-
-
-
-
- ; ********************************************************************************
- ;* *
- ;* 68k-only Transfer Function Prototypes *
- ;* *
- ;*******************************************************************************
-
- IF TARGET_CPU_68K THEN
- IF TARGET_RT_MAC_68881 THEN
- ;
- ; extern void x96tox80(const extended96 *x, extended80 *x80)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x96tox80
- ENDIF
-
- ;
- ; extern void x80tox96(const extended80 *x80, extended96 *x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x80tox96
- ENDIF
-
- ELSE
- ;
- ; extern void x96tox80(const extended96 *x96, extended80 *x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x96tox80
- ENDIF
-
- ;
- ; extern void x80tox96(const extended80 *x, extended96 *x96)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x80tox96
- ENDIF
-
- ENDIF ; TARGET_RT_MAC_68881
- ENDIF ; TARGET_CPU_68K
- ENDIF
- ; ********************************************************************************
- ;* *
- ;* PowerPC-only Function Prototypes *
- ;* *
- ;*******************************************************************************
-
-
- IF TARGET_CPU_PPC THEN
- ;
- ; extern long double cosl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION cosl
- ENDIF
-
- ;
- ; extern long double sinl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sinl
- ENDIF
-
- ;
- ; extern long double tanl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION tanl
- ENDIF
-
- ;
- ; extern long double acosl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION acosl
- ENDIF
-
- ;
- ; extern long double asinl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION asinl
- ENDIF
-
- ;
- ; extern long double atanl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atanl
- ENDIF
-
- ;
- ; extern long double atan2l(long double y, long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atan2l
- ENDIF
-
- ;
- ; extern long double coshl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION coshl
- ENDIF
-
- ;
- ; extern long double sinhl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sinhl
- ENDIF
-
- ;
- ; extern long double tanhl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION tanhl
- ENDIF
-
- ;
- ; extern long double acoshl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION acoshl
- ENDIF
-
- ;
- ; extern long double asinhl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION asinhl
- ENDIF
-
- ;
- ; extern long double atanhl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION atanhl
- ENDIF
-
- ;
- ; extern long double expl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION expl
- ENDIF
-
- ;
- ; extern long double expm1l(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION expm1l
- ENDIF
-
- ;
- ; extern long double exp2l(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION exp2l
- ENDIF
-
- ;
- ; extern long double frexpl(long double x, int *exponent)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION frexpl
- ENDIF
-
- ;
- ; extern long double ldexpl(long double x, int n)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ldexpl
- ENDIF
-
- ;
- ; extern long double logl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION logl
- ENDIF
-
- ;
- ; extern long double log1pl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log1pl
- ENDIF
-
- ;
- ; extern long double log10l(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log10l
- ENDIF
-
- ;
- ; extern long double log2l(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION log2l
- ENDIF
-
- ;
- ; extern long double logbl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION logbl
- ENDIF
-
- ;
- ; extern long double scalbl(long double x, long n)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION scalbl
- ENDIF
-
- ;
- ; extern long double fabsl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fabsl
- ENDIF
-
- ;
- ; extern long double hypotl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION hypotl
- ENDIF
-
- ;
- ; extern long double powl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION powl
- ENDIF
-
- ;
- ; extern long double sqrtl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION sqrtl
- ENDIF
-
- ;
- ; extern long double erfl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION erfl
- ENDIF
-
- ;
- ; extern long double erfcl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION erfcl
- ENDIF
-
- ;
- ; extern long double gammal(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION gammal
- ENDIF
-
- ;
- ; extern long double lgammal(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION lgammal
- ENDIF
-
- ;
- ; extern long double ceill(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ceill
- ENDIF
-
- ;
- ; extern long double floorl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION floorl
- ENDIF
-
- ;
- ; extern long double rintl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION rintl
- ENDIF
-
- ;
- ; extern long double nearbyintl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION nearbyintl
- ENDIF
-
- ;
- ; extern long rinttoll(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION rinttoll
- ENDIF
-
- ;
- ; extern long double roundl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION roundl
- ENDIF
-
- ;
- ; extern long roundtoll(long double round)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION roundtoll
- ENDIF
-
- ;
- ; extern long double truncl(long double x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION truncl
- ENDIF
-
- ;
- ; extern long double remainderl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION remainderl
- ENDIF
-
- ;
- ; extern long double remquol(long double x, long double y, int *quo)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION remquol
- ENDIF
-
- ;
- ; extern long double copysignl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION copysignl
- ENDIF
-
- ;
- ; extern long double fdiml(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fdiml
- ENDIF
-
- ;
- ; extern long double fmaxl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fmaxl
- ENDIF
-
- ;
- ; extern long double fminl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION fminl
- ENDIF
-
-
- IF &TYPE('__NOEXTENSIONS__') = 'UNDEFINED' THEN
- ;
- ; extern relop relationl(long double x, long double y)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION relationl
- ENDIF
-
- ;
- ; extern void num2decl(const decform *f, long double x, decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION num2decl
- ENDIF
-
- ;
- ; extern long double dec2numl(const decimal *d)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dec2numl
- ENDIF
-
- ;
- ; MathLib v2 has two new transfer functions: x80tod and dtox80. They can
- ; be used to directly transform 68k 80-bit extended data types to double
- ; and back for PowerPC based machines without using the functions
- ; x80told or ldtox80. Double rounding may occur.
- ;
-
- ;
- ; extern void x80told(const extended80 *x80, long double *x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x80told
- ENDIF
-
- ;
- ; extern void ldtox80(const long double *x, extended80 *x80)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ldtox80
- ENDIF
-
- ;
- ; extern double x80tod(const extended80 *x80)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x80tod
- ENDIF
-
- ;
- ; extern void dtox80(const double *x, extended80 *x80)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION dtox80
- ENDIF
-
- ENDIF
- ENDIF ; TARGET_CPU_PPC
- ELSE
- ;
- ; Non-Mac platforms may have long doubles.
- ;
-
- ;
- ; extern void x80told(const extended80 *x80, long double *x)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION x80told
- ENDIF
-
- ;
- ; extern void ldtox80(const long double *x, extended80 *x80)
- ;
- IF TARGET_OS_MAC ** TARGET_RT_MAC_CFM THEN
- IMPORT_CFM_FUNCTION ldtox80
- ENDIF
-
- ENDIF ; TARGET_OS_MAC
- ENDIF ; __FP__
-
-